home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectPlay / Conferencer / frmWhiteBoard.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-10-08  |  9.2 KB  |  221 lines
  1. VERSION 5.00
  2. Begin VB.Form frmWhiteBoard 
  3.    Caption         =   "Whiteboard"
  4.    ClientHeight    =   7200
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   9600
  8.    Icon            =   "frmWhiteBoard.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   7200
  11.    ScaleWidth      =   9600
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.PictureBox picDraw 
  14.       AutoRedraw      =   -1  'True
  15.       BackColor       =   &H00FFFFFF&
  16.       Height          =   7155
  17.       Left            =   0
  18.       ScaleHeight     =   7095
  19.       ScaleWidth      =   9495
  20.       TabIndex        =   0
  21.       Top             =   0
  22.       Width           =   9555
  23.    End
  24.    Begin VB.Menu Pop 
  25.       Caption         =   "mnuPop"
  26.       Visible         =   0   'False
  27.       Begin VB.Menu mnuRed 
  28.          Caption         =   "Draw with Red"
  29.       End
  30.       Begin VB.Menu mnuBlue 
  31.          Caption         =   "Draw with Blue"
  32.       End
  33.       Begin VB.Menu mnuGreen 
  34.          Caption         =   "Draw with Green"
  35.       End
  36.       Begin VB.Menu mnuGrey 
  37.          Caption         =   "Draw with Grey"
  38.       End
  39.       Begin VB.Menu mnuPurp 
  40.          Caption         =   "Draw with Purple"
  41.       End
  42.       Begin VB.Menu mnuYellow 
  43.          Caption         =   "Draw with Yellow"
  44.       End
  45.       Begin VB.Menu mnuSep 
  46.          Caption         =   "-"
  47.       End
  48.       Begin VB.Menu mnuClear 
  49.          Caption         =   "Clear Board"
  50.       End
  51.    End
  52. Attribute VB_Name = "frmWhiteBoard"
  53. Attribute VB_GlobalNameSpace = False
  54. Attribute VB_Creatable = False
  55. Attribute VB_PredeclaredId = True
  56. Attribute VB_Exposed = False
  57. Option Explicit
  58. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  59. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  60. '  File:       frmWhiteBoard.frm
  61. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  62. Implements DirectPlay8Event
  63. Private mlColor As Long
  64. Private mlLastX As Single: Private mlLastY As Single
  65. Private Sub Form_Resize()
  66.     picDraw.Move 0, 0, Me.Width, Me.Height
  67. End Sub
  68. Private Sub mnuBlue_Click()
  69.     mlColor = RGB(0, 0, 255)
  70. End Sub
  71. Private Sub mnuClear_Click()
  72.     Dim lMsg As Long, lOffset As Long
  73.     Dim oBuf() As Byte
  74.     picDraw.Cls
  75.     'Send the clear msg
  76.     lOffset = NewBuffer(oBuf)
  77.     lMsg = MsgClearWhiteBoard
  78.     AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  79.     dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
  80. End Sub
  81. Private Sub mnuGreen_Click()
  82.     mlColor = RGB(0, 255, 0)
  83. End Sub
  84. Private Sub mnuGrey_Click()
  85.     mlColor = RGB(128, 128, 128)
  86. End Sub
  87. Private Sub mnuPurp_Click()
  88.     mlColor = RGB(156, 56, 167)
  89. End Sub
  90. Private Sub mnuRed_Click()
  91.     mlColor = RGB(255, 0, 0)
  92. End Sub
  93. Private Sub mnuYellow_Click()
  94.     mlColor = RGB(255, 255, 0)
  95. End Sub
  96. Private Sub picDraw_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  97.     Dim lMsg As Long, lOffset As Long
  98.     Dim oBuf() As Byte
  99.     If Button = vbLeftButton Then 'We are drawing
  100.         If mlColor = 0 Then mlColor = RGB(255, 0, 0)
  101.         'First draw the dot
  102.         picDraw.PSet (X, Y), mlColor
  103.         'Now tell everyone about it
  104.         
  105.         'Now let's send a message to draw this dot
  106.         lOffset = NewBuffer(oBuf)
  107.         lMsg = MsgSendDrawPixel
  108.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  109.         AddDataToBuffer oBuf, mlColor, LenB(mlColor), lOffset
  110.         AddDataToBuffer oBuf, X, SIZE_SINGLE, lOffset
  111.         AddDataToBuffer oBuf, Y, SIZE_SINGLE, lOffset
  112.         dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
  113.         'Now store the last x/y
  114.         mlLastX = X: mlLastY = Y
  115.     End If
  116. End Sub
  117. Private Sub picDraw_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  118.     Dim lMsg As Long, lOffset As Long
  119.     Dim oBuf() As Byte
  120.     If Button = vbLeftButton Then 'We are drawing
  121.         If mlColor = 0 Then mlColor = RGB(255, 0, 0)
  122.         'First draw the dot
  123.         picDraw.Line (mlLastX, mlLastY)-(X, Y), mlColor
  124.         'Now tell everyone about it
  125.         
  126.         'Now let's send a message to draw this line
  127.         lOffset = NewBuffer(oBuf)
  128.         lMsg = MsgSendDrawLine
  129.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  130.         AddDataToBuffer oBuf, mlColor, LenB(mlColor), lOffset
  131.         AddDataToBuffer oBuf, mlLastX, SIZE_SINGLE, lOffset
  132.         AddDataToBuffer oBuf, mlLastY, SIZE_SINGLE, lOffset
  133.         AddDataToBuffer oBuf, X, SIZE_SINGLE, lOffset
  134.         AddDataToBuffer oBuf, Y, SIZE_SINGLE, lOffset
  135.         dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
  136.         'Now store the last x/y
  137.         mlLastX = X: mlLastY = Y
  138.     End If
  139. End Sub
  140. Private Sub picDraw_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  141.     If Button = vbRightButton Then
  142.         PopupMenu Pop
  143.     End If
  144. End Sub
  145. Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
  146.     'VB requires that we must implement *every* member of this interface
  147. End Sub
  148. Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
  149.     'VB requires that we must implement *every* member of this interface
  150. End Sub
  151. Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
  152.     'VB requires that we must implement *every* member of this interface
  153. End Sub
  154. Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
  155.     'VB requires that we must implement *every* member of this interface
  156. End Sub
  157. Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
  158.     'VB requires that we must implement *every* member of this interface
  159. End Sub
  160. Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
  161.     'VB requires that we must implement *every* member of this interface
  162. End Sub
  163. Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  164.     'VB requires that we must implement *every* member of this interface
  165. End Sub
  166. Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
  167.     'VB requires that we must implement *every* member of this interface
  168. End Sub
  169. Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
  170.     'VB requires that we must implement *every* member of this interface
  171. End Sub
  172. Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
  173.     'VB requires that we must implement *every* member of this interface
  174. End Sub
  175. Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
  176.     'VB requires that we must implement *every* member of this interface
  177. End Sub
  178. Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
  179.     'VB requires that we must implement *every* member of this interface
  180. End Sub
  181. Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
  182.     'VB requires that we must implement *every* member of this interface
  183. End Sub
  184. Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
  185.     'VB requires that we must implement *every* member of this interface
  186. End Sub
  187. Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
  188.     'All we care about in this form is what msgs we receive.
  189.     Dim lMsg As Long, lOffset As Long
  190.     Dim lColor As Long
  191.     Dim lX As Single, lY As Single
  192.     Dim lX1 As Single, lY1 As Single
  193.     With dpnotify
  194.     GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
  195.     Select Case lMsg
  196.     Case MsgSendDrawPixel
  197.         GetDataFromBuffer .ReceivedData, lColor, LenB(lColor), lOffset
  198.         GetDataFromBuffer .ReceivedData, lX, LenB(lX), lOffset
  199.         GetDataFromBuffer .ReceivedData, lY, LenB(lY), lOffset
  200.         On Error Resume Next
  201.         picDraw.PSet (lX, lY), lColor
  202.     Case MsgSendDrawLine
  203.         GetDataFromBuffer .ReceivedData, lColor, LenB(lColor), lOffset
  204.         GetDataFromBuffer .ReceivedData, lX, LenB(lX), lOffset
  205.         GetDataFromBuffer .ReceivedData, lY, LenB(lY), lOffset
  206.         GetDataFromBuffer .ReceivedData, lX1, LenB(lX), lOffset
  207.         GetDataFromBuffer .ReceivedData, lY1, LenB(lY), lOffset
  208.         On Error Resume Next
  209.         picDraw.Line (lX, lY)-(lX1, lY1), lColor
  210.     Case MsgClearWhiteBoard
  211.         picDraw.Cls
  212.     End Select
  213.     End With
  214. End Sub
  215. Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
  216.     'VB requires that we must implement *every* member of this interface
  217. End Sub
  218. Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
  219.     'VB requires that we must implement *every* member of this interface
  220. End Sub
  221.